home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 44 / PC Actual CD 44.iso / Linux / Cygwin / full.exe / Disk1 / data1.cab / Tools / share / tix4.1 / VStack.tcl < prev    next >
Encoding:
Text File  |  1998-12-04  |  9.3 KB  |  427 lines
  1. # VStack.tcl --
  2. #
  3. #    Virtual base class, do not instantiate!  This is the core
  4. #    class for all NoteBook style widgets. Stack maintains a list
  5. #    of windows. It provides methods to create, delete windows as
  6. #    well as stepping through them.
  7. #
  8. # Copyright (c) 1996, Expert Interface Technologies
  9. #
  10. # See the file "license.terms" for information on usage and redistribution
  11. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12. #
  13. #
  14.  
  15.  
  16. tixWidgetClass tixVStack {
  17.     -virtual true
  18.     -classname TixVStack
  19.     -superclass tixPrimitive
  20.     -method {
  21.     add delete pageconfigure pagecget pages raise raised
  22.     }
  23.     -flag {
  24.     -dynamicgeometry -ipadx -ipady
  25.     }
  26.     -configspec {
  27.     {-dynamicgeometry dynamicGeometry DynamicGeometry 0 tixVerifyBoolean}
  28.     {-ipadx ipadX Pad 0}
  29.     {-ipady ipadY Pad 0}
  30.     }
  31. }
  32.  
  33. proc tixVStack:InitWidgetRec {w} {
  34.     upvar #0 $w data
  35.  
  36.     tixChainMethod $w InitWidgetRec
  37.  
  38.     set data(pad-x1) 0
  39.     set data(pad-x2) 0
  40.     set data(pad-y1) 0
  41.     set data(pad-y2) 0
  42.  
  43.     set data(windows)  ""
  44.     set data(nWindows) 0
  45.     set data(topchild) ""
  46.  
  47.     set data(minW)   1
  48.     set data(minH)   1
  49.  
  50.     set data(w:top)  $w
  51.     set data(counter) 0
  52.     set data(repack) 0
  53. }
  54.  
  55. proc tixVStack:SetBindings {w} {
  56.     upvar #0 $w data
  57.  
  58.     tixChainMethod $w SetBindings
  59.     tixCallMethod $w InitGeometryManager
  60. }
  61.  
  62. #----------------------------------------------------------------------
  63. # Public methods
  64. #----------------------------------------------------------------------
  65. proc tixVStack:add {w child args} {
  66.     upvar #0 $w data
  67.  
  68.     set validOptions {-createcmd -raisecmd}
  69.  
  70.     set opt(-createcmd)  ""
  71.     set opt(-raisecmd)   ""
  72.  
  73.     tixHandleOptions -nounknown opt $validOptions $args
  74.  
  75.     set data($child,raisecmd)  $opt(-raisecmd)
  76.     set data($child,createcmd) $opt(-createcmd)
  77.  
  78.     set data(w:$child) [tixCallMethod $w CreateChildFrame $child]
  79.  
  80.     lappend data(windows) $child
  81.     incr data(nWindows) 1
  82.  
  83.     return $data(w:$child) 
  84. }
  85.  
  86. proc tixVStack:delete {w child} {
  87.     upvar #0 $w data
  88.  
  89.     if [info exists data($child,createcmd)] {
  90.     if [winfo exists $data(w:$child)] {
  91.         bind $data(w:$child) <Destroy> {;}
  92.         destroy $data(w:$child)
  93.     }
  94.     catch {unset data($child,createcmd)}
  95.     catch {unset data($child,raisecmd)}
  96.     catch {unset data(w:$child)}
  97.  
  98.     set index [lsearch $data(windows) $child]
  99.     if {$index >= 0} {
  100.         set data(windows) [lreplace $data(windows) $index $index]
  101.         incr data(nWindows) -1
  102.     }
  103.  
  104.     if ![string comp $data(topchild) $child] {
  105.         set data(topchild) ""
  106.         foreach page $data(windows) {
  107.         if [string comp $page $child] {
  108.             $w raise $page
  109.             set data(topchild) $page
  110.             break
  111.         }
  112.         }
  113.     }
  114.     } else {
  115.     error "page $child does not exist"
  116.     }
  117. }
  118.  
  119. proc tixVStack:pagecget {w child option} {
  120.     upvar #0 $w data
  121.  
  122.     if {![info exists data($child,createcmd)]} {
  123.     error "page \"$child\" does not exist in $w"
  124.     }
  125.  
  126.     case $option {
  127.     -createcmd {
  128.         return "$data($child,createcmd)"
  129.     }
  130.     -raisecmd {
  131.         return "$data($child,raisecmd)"
  132.     }
  133.     default {
  134.         if {$data(w:top) != $w} {
  135.         return [$data(w:top) pagecget $child $option]
  136.         } else {
  137.         error "unknown option \"$option\""
  138.         }
  139.     }
  140.     }
  141. }
  142.  
  143. proc tixVStack:pageconfigure {w child args} {
  144.     upvar #0 $w data
  145.  
  146.     if {![info exists data($child,createcmd)]} {
  147.     error "page \"$child\" does not exist in $w"
  148.     }
  149.  
  150.     set len [llength $args]
  151.  
  152.     if {$len == 0} {
  153.     set value [$data(w:top) pageconfigure $child]
  154.     lappend value [list -createcmd "" "" "" $data($child,createcmd)]
  155.     lappend value [list -raisecmd "" "" "" $data($child,raisecmd)]
  156.     return $value
  157.     }
  158.  
  159.     if {$len == 1} {
  160.     case [lindex $args 0] {
  161.         -createcmd {
  162.         return [list -createcmd "" "" "" $data($child,createcmd)]
  163.         }
  164.         -raisecmd {
  165.         return [list -raisecmd "" "" "" $data($child,raisecmd)]
  166.         }
  167.         default {
  168.         return [$data(w:top) pageconfigure $child [lindex $args 0]]
  169.         }
  170.     }
  171.     }
  172.  
  173.     # By default handle each of the options
  174.     #
  175.     set opt(-createcmd)  $data($child,createcmd)
  176.     set opt(-raisecmd)   $data($child,raisecmd)
  177.  
  178.     tixHandleOptions -nounknown opt {-createcmd -raisecmd} $args
  179.  
  180.     #
  181.     # the widget options
  182.     set new_args ""
  183.     tixForEach {flag value} $args {
  184.     if {$flag != "-createcmd" && $flag != "-raisecmd"} {
  185.         lappend new_args $flag
  186.         lappend new_args $value
  187.     }
  188.     }
  189.  
  190.     if {[llength $new_args] >= 2} {
  191.     eval $data(w:top) pageconfig $child $new_args
  192.     }
  193.  
  194.     #
  195.     # The add-on options
  196.     set data($child,raisecmd)  $opt(-raisecmd)
  197.     set data($child,createcmd) $opt(-createcmd)
  198.  
  199.     return ""
  200. }
  201.  
  202. proc tixVStack:pages {w} {
  203.     upvar #0 $w data
  204.  
  205.     return $data(windows)
  206. }
  207.  
  208. proc tixVStack:raise {w child} {
  209.     upvar #0 $w data
  210.  
  211.     if {![info exists data($child,createcmd)]} {
  212.     error "page $child does not exist"
  213.     }
  214.  
  215.     if {[info exists data($child,createcmd)] && $data($child,createcmd) !=""} {
  216.     uplevel #0 $data($child,createcmd)
  217.     set data($child,createcmd) ""
  218.     }
  219.  
  220.     tixCallMethod $w RaiseChildFrame $child
  221.  
  222.     set oldTopChild $data(topchild)
  223.     set data(topchild) $child
  224.  
  225.     if [string comp $oldTopChild $child] {
  226.     if [string comp $child,raisecmd ""] {
  227.          uplevel #0 $data($child,raisecmd)
  228.     }
  229.     }
  230. }
  231.  
  232. proc tixVStack:raised {w} {
  233.     upvar #0 $w data
  234.  
  235.     return $data(topchild)
  236. }
  237.  
  238. #----------------------------------------------------------------------
  239. # Virtual Methods
  240. #----------------------------------------------------------------------
  241. proc tixVStack:InitGeometryManager {w} {
  242.     upvar #0 $w data
  243.  
  244.     bind $w <Configure> "tixVStack:MasterGeomProc $w"
  245.     bind $data(w:top) <Destroy> "+tixVStack:DestroyTop $w"
  246.  
  247.     if {$data(repack) == 0} {
  248.     set data(repack) 1
  249.     tixWidgetDoWhenIdle tixCallMethod $w Resize
  250.     }
  251. }
  252.  
  253. proc tixVStack:CreateChildFrame {w child} {
  254.     upvar #0 $w data
  255.  
  256.     set f [frame $data(w:top).$child]
  257.  
  258.     tixManageGeometry $f "tixVStack:ClientGeomProc $w"
  259.     bind $f <Configure> "tixVStack:ClientGeomProc $w -configure $f"
  260.     bind $f <Destroy>   "$w delete $child"
  261.  
  262.     return $f
  263. }
  264.  
  265. proc tixVStack:RaiseChildFrame {w child} {
  266.     upvar #0 $w data
  267.  
  268.     # Hide the original visible window
  269.     if {[string comp $data(topchild) ""] &&
  270.     [string comp $data(topchild) $child]} {
  271.     tixUnmapWindow $data(w:$data(topchild))
  272.     }
  273.  
  274.     set myW [winfo width  $w]
  275.     set myH [winfo height $w]
  276.  
  277.     set cW [expr $myW - $data(pad-x1) - $data(pad-x2) - 2*$data(-ipadx)]
  278.     set cH [expr $myH - $data(pad-y1) - $data(pad-y2) - 2*$data(-ipady)]
  279.     set cX [expr $data(pad-x1) + $data(-ipadx)]
  280.     set cY [expr $data(pad-y1) + $data(-ipady)]
  281.  
  282.     if {$cW > 0 && $cH > 0} {
  283.     tixMoveResizeWindow $data(w:$child) $cX $cY $cW $cH
  284.     tixMapWindow $data(w:$child)
  285.     raise $data(w:$child)
  286.     }
  287. }
  288.  
  289.  
  290.  
  291. #----------------------------------------------------------------------
  292. #
  293. #        G E O M E T R Y   M A N A G E M E N T
  294. #
  295. #----------------------------------------------------------------------
  296. proc tixVStack:DestroyTop {w} {
  297.     catch {
  298.     destroy $w
  299.     }
  300. }
  301.  
  302. proc tixVStack:MasterGeomProc {w args} {
  303.     if {![winfo exists $w]} {
  304.     return
  305.     }
  306.  
  307.     upvar #0 $w data
  308.  
  309.     if {$data(repack) == 0} {
  310.     set data(repack) 1
  311.     tixWidgetDoWhenIdle tixCallMethod $w Resize
  312.     }
  313. }
  314.  
  315. proc tixVStack:ClientGeomProc {w flag client} {
  316.     if {![winfo exists $w]} {
  317.     return
  318.     }
  319.     upvar #0 $w data
  320.  
  321.     if {$data(repack) == 0} {
  322.     set data(repack) 1
  323.     tixWidgetDoWhenIdle tixCallMethod $w Resize
  324.     }
  325.  
  326.     if {$flag == "-lostslave"} {
  327.     error "Geometry Management Error: \
  328. Another geometry manager has taken control of $client.\
  329. This error is usually caused because a widget has been created\
  330. in the wrong frame: it should have been created inside $client instead\
  331. of $w"
  332.     }
  333. }
  334.  
  335. proc tixVStack:Resize {w} {
  336.     if {![winfo exists $w]} {
  337.     return
  338.     }
  339.  
  340.     upvar #0 $w data
  341.  
  342.     if {$data(nWindows) == 0} {
  343.     set data(repack) 0
  344.     return
  345.     }
  346.  
  347.     if {$data(-width) == 0 || $data(-height) == 0} {
  348.     if {!$data(-dynamicgeometry)} {
  349.         # Calculate my required width and height
  350.         #
  351.         set maxW 1
  352.         set maxH 1
  353.  
  354.         foreach child $data(windows) {
  355.         set cW [winfo reqwidth  $data(w:$child)]
  356.         set cH [winfo reqheight $data(w:$child)]
  357.  
  358.         if {$maxW < $cW} {
  359.             set maxW $cW
  360.         }
  361.         if {$maxH < $cH} {
  362.             set maxH $cH
  363.         }
  364.         }
  365.         set reqW $maxW
  366.         set reqH $maxH
  367.     } else {
  368.         if [string comp $data(topchild) ""] {
  369.         set reqW [winfo reqwidth  $data(w:$data(topchild))]
  370.         set reqH [winfo reqheight $data(w:$data(topchild))]
  371.         } else {
  372.         set reqW 1
  373.         set reqH 1
  374.         }
  375.     }
  376.  
  377.     incr reqW [expr $data(pad-x1) + $data(pad-x2) + 2*$data(-ipadx)]
  378.     incr reqH [expr $data(pad-y1) + $data(pad-y2) + 2*$data(-ipady)]
  379.  
  380.     if {$reqW < $data(minW)} {
  381.         set reqW $data(minW)
  382.     }
  383.     if {$reqH < $data(minH)} {
  384.         set reqH $data(minH)
  385.     }
  386.     }
  387.     # These take higher precedence
  388.     #
  389.     if {$data(-width)  != 0} {
  390.     set reqW $data(-width)
  391.     }
  392.     if {$data(-height) != 0} {
  393.     set reqH $data(-height)
  394.     }
  395.  
  396.     if {[winfo reqwidth $w] != $reqW || [winfo reqheight $w] != $reqH} {
  397.     if {![info exists data(counter)]} {
  398.         set data(counter) 0
  399.     }
  400.         if {$data(counter) < 50} {
  401.             incr data(counter)
  402.         tixGeometryRequest $w $reqW $reqH
  403.         tixWidgetDoWhenIdle tixCallMethod $w Resize
  404.         set data(repack) 1
  405.         return
  406.     }
  407.     }
  408.     set data(counter) 0
  409.  
  410.     if [string comp $data(w:top) $w] {
  411.     tixMoveResizeWindow $data(w:top) 0 0 [winfo width $w] [winfo height $w]
  412.     tixMapWindow $data(w:top)
  413.     }
  414.  
  415.     if ![string comp $data(topchild) ""] {
  416.     set top [lindex $data(windows) 0]
  417.     } else {
  418.     set top $data(topchild)
  419.     }
  420.  
  421.     if [string comp $top ""] {
  422.     tixCallMethod $w raise $top
  423.     }
  424.  
  425.     set data(repack) 0
  426. }
  427.